home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
MSDOS
/
(m)aal
/
CUTFILE2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-10-11
|
6KB
|
206 lines
PROGRAM Cutfile;
{$U-}
{$C-}
{$I c:\pas\uti\util2.lib}
TYPE
String50 = STRING[50];
CONST
DataRecSize = 1; (* bytes *)
DiskSpaceFree : Real = 360400.0; (* Maximum size on disk *)
VAR
Datafile : FILE;
OutFile : FILE;
Byte1 : Byte;
xzx : Char;
RecsRead, RecsWrote, buffsize,
NumberOfChunks : Integer;
Chunk, Datafilesize,
RecsAlreadyWritten : Real;
NoMoreRecs, FileisDone : Boolean;
DataArray : ARRAY[1..30000] OF Byte;
FN : STRING[1];
FN2 : STRING[2];
Outfilename, Inputfilename,
Destinationfilename : STRING[150];
pnr, I, num, FileNum : Integer;
FUNCTION FreeDiskSpace(Drive : Char) : Real;
TYPE
RegType = RECORD CASE Byte OF {Used for DOS calls. }
1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer);
2 : (AL, AH, BL, BH, CL, CH, DL, DH : Byte);
END;
VAR
Regpack : RegType; {record for MsDos call}
BEGIN (* GetFreeDiskSpace*)
WITH RegPack DO
BEGIN (* With RegPack *)
AH := $36;
CASE UpCase(Drive) OF
'A' : DL := 1;
'B' : DL := 2;
'C' : DL := 3;
'D' : DL := 4;
'E' : DL := 5;
'F' : DL := 6;
'G' : DL := 7;
'H' : DL := 8;
'I' : DL := 9;
'J' : DL := 10;
ELSE Dl := 0;
END (* case *)
END; (* With RegPack *)
MsDos(regpack);
WITH regpack DO
BEGIN
IF AX = $FFFF THEN (* error has occured *)
BEGIN
WriteLn('Dos reports Invalid Drive or other error');
WriteLn('Program Execution Terminated');
Halt; (*Program execution stops here*)
END;
FreeDiskSpace := 1.0*RegPack.AX*RegPack.BX*RegPack.CX*1.0;
END;
END; (* FreeDiskSpace *)
FUNCTION ReadFileName(Description : String50) : String80;
(**************************************************************************)
VAR
Infilename : String80;
FileExists : Boolean;
BEGIN
REPEAT
WriteLn('Please enter the name of the ', description, ' file ');
ReadLn(infilename);
IF Exist(infilename) THEN
BEGIN
FileExists := True;
END
ELSE
BEGIN
FileExists := False;
WriteLn('File not Found!! Press any key or Ctrl C to abort');
Read(Kbd, xzx);
END;
UNTIL (FileExists OR (Ord(xzx) = $03));
IF Ord(xzx) = $03 THEN
BEGIN
WriteLn('Program Terminated');
Halt;
END;
ReadFileName := Infilename;
END; (* ReadFileName*)
FUNCTION WriteFileName(Description : String50) : String80;
(**************************************************************************)
VAR
Infilename : String80;
FileExists : Boolean;
BEGIN
REPEAT
WriteLn('Please enter the name of the ', description, ' file ');
ReadLn(infilename);
IF Exist(infilename) THEN
FileExists := True
ELSE
BEGIN
FileExists := False;
END;
UNTIL (NOT FileExists OR (Ord(infilename[1]) = $03));
IF Ord(infilename[1]) = $03 THEN Halt;
WriteFileName := Infilename;
END; (* ReadFileName*)
PROCEDURE WriteFile(FileNum : Integer; NumberOfBytesAvailable : Real);
(**************************************************************************)
BEGIN (*WriteFile*)
IF FileNum < 10 THEN
BEGIN
Str(FileNum, FN);
Outfilename := Destinationfilename+'.'+FN;
END
ELSE
BEGIN
Str(filenum, FN2);
Outfilename := Destinationfilename+'.'+FN2;
END;
WriteLn('There are ', NumberOfBytesAvailable, ' available');
WriteLn('Writing ', Outfilename);
Assign(Outfile, Outfilename);
Rewrite(outfile, 1);
LongSeek(Datafile, RecsAlreadyWritten);
IF NumberOfBytesAvailable > 30000 THEN
Buffsize := 30000
ELSE
BuffSize := Trunc(NumberOfBytesAvailable);
Chunk := 0;
REPEAT
BlockRead(datafile, DataArray, Buffsize, Recsread);
BlockWrite(outfile, DataArray, RecsRead);
chunk := RecsRead+Chunk;
WriteLn('Read ', RecsRead:6, ' recs and wrote ', Chunk:6);
IF Abs(NumberOfBytesAvailable-chunk) < 30000 THEN
Buffsize := Trunc(NumberOfBytesAvailable-chunk);
UNTIL ((chunk >= NumberOfBytesAvailable) OR (RecsRead < 1));
RecsAlreadyWritten := RecsAlreadyWritten+Chunk;
Close(outfile);
IF RecsAlreadyWritten >= DataFileSize THEN
FileIsDone := True
ELSE
FileIsDone := False;
END; (* WriteFile *)
PROCEDURE TransferFileToFloppies;
(**************************************************************************)
VAR
I : Integer;
Drive : Char;
BEGIN (*TransferPartOfFile*)
RecsAlreadyWritten := 0;
Assign(datafile, inputfilename);
Reset(datafile, 1);
DataFileSize := LongFileSize(datafile);
FOR I := 1 TO 3 DO
BEGIN
IF DestinationFileName[I] = ':' THEN
BEGIN
Drive := DestinationFileName[Pred(I)];
i := 3
END;
END;
FileNum := 1;
REPEAT
WriteLn('Please get Destination drive ready.. Press any key when ready');
Read(Kbd, xzx);
IF Ord(xzx) = $03 THEN
BEGIN
Close(datafile);
Close(Outfile);
WriteLn('Program Terminated by Ctrl C');
Halt;
END;
DiskSpaceFree := FreeDiskSpace(Drive);
WriteFile(FileNum, DiskSpaceFree);
Filenum := Succ(fileNum);
UNTIL FileIsDone;
Close(Datafile);
END;
BEGIN
xzx := ' ';
InputFileName := ReadFileName('input (include Extension)');
DestinationFileName := WriteFileName('Destination (include path, no extension');
TransferFileToFloppies;
END.